﻿Imports System
Imports System.IO
Imports System.Xml
Imports System.Text
Imports System.Net
Imports MSXML2

Public Class SOAPExchanges
    Public Login As String = ""
    Public PW As String = ""
    Public server As String = ""
    Public database As String = ""
    Private hashpass As String

    Public Sub New()
    End Sub

    Public Function GetArasDBnames()

        Dim result As MSXML2.DOMDocument = New MSXML2.DOMDocument

        Return result

    End Function

    Public Function UploadFiletoVault(ByVal FilePathToUp As String, ByVal VaultID As String)

FirstConnectionPb:

        'Get form filled database name
        Dim DatabaseName As String = Me.database

        'Add Vault server path and database name parameter to the address root path 
        Dim VURL As String = Me.server & "vault/vaultserver.aspx" & "?dbname=" & DatabaseName

        Dim FILENAME As String
        Dim FILEPATH As String = FilePathToUp 'path + filename given as parameter to the method
        Dim FilepathSplit() As String


        'Get the filename
        FilepathSplit = FILEPATH.Split("\")
        FILENAME = FilepathSplit.Last
        Dim file As FileInfo = New FileInfo(FILEPATH)
        Dim resultstring As String = ""

        ' Gets a non existing Random ID
        resultstring = GetRandomArasID()

        Dim FILEID As String = resultstring
        Dim VAdminLogin As String = Me.Login
        Dim VAdminPwd As String = Me.PW

        '================================================================================================'
        ' All the following code was nicely provided by Peter Schroer from Aras Corp
        ' It basically follows the following process:
        ' 1)	makes the AML for the Document and File check-in
        ' 2)	send this AML to the VaultServer,  with the actual file(s) streamed on the SOAP message
        ' 3)	Vault server will take the physical file from the stream,  and save it
        ' 4)	Vault Server will then take the AML,  and re-post it towards the InnovatorServer.aspx
        ' 5)	InnovatorServer will create the database entries, and return a result to VaultServer
        ' 6)	VaultServer takes the return message, and re-sends this to the Client
        '================================================================================================='

        Dim contentSB As StringBuilder = New StringBuilder
        Dim brline As String = "----ECP"  '<-- this is arbitrary,  just need a unique dividing character string to go between the multi-part contents
        Dim endLine As String = brline & vbCrLf
        Dim inXml As String = "<Item type='File' action='add' id='" & FILEID & "'>" & _
                                "<file_type>JPG</file_type><filename>" & FILENAME & "</filename><Relationships>" & _
                                "<Item type='Located' action='add'>" & _
                                "<related_id>" & VaultID & "</related_id>" & _
                                "</Item></Relationships></Item>"

        ' NOTE:  when you send a File to the InnovatorServer,  you must have the Located relationship !
        ' remember that Aras is a multi-vault, system,  so this relationship points to a Vault Item.
        ' Note I am using 67BBB9204FE84A8981ED8313049BA06C which is the ID of the Default vault item

        contentSB.Append(brline)
        contentSB.Append(vbCrLf)
        contentSB.Append("Content-Disposition: form-data; name=""")
        contentSB.Append("XMLdata")
        contentSB.Append("""" & vbCrLf & vbCrLf)
        contentSB.Append(inXml)
        contentSB.Append(vbCrLf)

        Dim content As String = contentSB.ToString()
        Dim postDatabytes() As Byte = Encoding.UTF8.GetBytes(content)
        Dim contenLength As Integer = postDatabytes.Length

        Dim fContent As String = ""
        fContent = fContent & brline & vbCrLf
        fContent = fContent & "Content-Disposition: form-data; name=""" & FILEID & """; filename=""" & file.FullName & """;" & vbCrLf
        fContent = fContent & vbCrLf

        Dim fContentBytes As Byte() = Encoding.UTF8.GetBytes(fContent)
        Dim newContenLength As Integer = contenLength + fContentBytes.Length + CInt(file.Length) + 2

        Dim uri As System.Uri = New System.Uri(VURL)
        Dim wReq As HttpWebRequest = CType(WebRequest.Create(uri), HttpWebRequest)
        Dim utf8 As New System.Text.UTF8Encoding
        wReq.CookieContainer = New CookieContainer

        wReq.Method = "POST"

        Dim endLinebytes() As Byte = Encoding.UTF8.GetBytes(endLine)
        wReq.ContentLength = contenLength + endLinebytes.Length

        wReq.ContentType = "multipart/form-data; boundary=" & brline.Substring(2)
        wReq.SendChunked = True
        wReq.KeepAlive = True
        wReq.Headers.Add("SOAPAction", "ApplyItem")
        wReq.ProtocolVersion = HttpVersion.Version11
        wReq.UserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; MyIE2; .NET CLR 1.1.4322)"
        wReq.ContentType = "multipart/form-data; boundary=" + brline.Substring(2)
        wReq.AllowWriteStreamBuffering = False

        wReq.Headers.Add("AUTHUSER", VAdminLogin)
        wReq.Headers.Add("AUTHPASSWORD", VAdminPwd)
        wReq.Headers.Add("DATABASE", DatabaseName)
        wReq.Headers.Add("LIKEVALIDATEUSER", "1")




        ' push out the header  xml and the File boundary
        Dim outStream As Stream = wReq.GetRequestStream()
        outStream.Write(postDatabytes, 0, postDatabytes.Length)
        outStream.Flush()

        Dim dtbytes As Byte() = Encoding.UTF8.GetBytes(fContent)
        outStream.Write(dtbytes, 0, dtbytes.Length)
        outStream.Flush()

        Dim Fis As Stream = New FileStream(file.FullName, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)

        Dim bufferSize As Integer = 1024
        Dim b(bufferSize) As Byte

        Dim readBytes As Integer = Fis.Read(b, 0, bufferSize)
        Do While (readBytes > 0)
            outStream.Write(b, 0, readBytes)
            readBytes = Fis.Read(b, 0, bufferSize)
        Loop
        outStream.Flush()

        Dim newLine As Byte() = Encoding.UTF8.GetBytes(vbCrLf)
        outStream.Write(newLine, 0, newLine.Length)

        outStream.Write(endLinebytes, 0, endLinebytes.Length)
        outStream.Flush()
        outStream.Close()

        Dim inStream As Stream = wReq.GetResponse().GetResponseStream()
        Dim br As StreamReader = New StreamReader(inStream, True)
        Dim ReplicationServerResponse As String = br.ReadToEnd()

        '  ReplicationServerResponse will have the XML response from the InnovatorServer + VaultServer
        '
        ' DONE

        Dim xmlanswer As Xml.XmlDocument = New Xml.XmlDocument
        xmlanswer.LoadXml(ReplicationServerResponse)
        Dim xmlfault As XmlNodeList
        Dim xmlfaultnode As Xml.XmlNode
        Dim msgerreur As String = "File Uploaded Correctly"


        ' This gets the fault message if exists
        xmlfault = xmlanswer.GetElementsByTagName("faultstring")
        If xmlfault.Count > 0 Then
            For Each xmlfaultnode In xmlfault
                msgerreur = xmlfaultnode.InnerText
            Next
        End If

        ' the following lines should be removed it was just a trick to 
        ' skip the first upload failed because of an unconnected attempt
        ' the solution can be to launch a first connection before all this.


        MsgBox(msgerreur)

    End Function

    Public Function GetVaultFile()

        Dim resultSoap As Xml.XmlDocument
        Dim AML As String = "" & _
        "<Item type='file' action='get' Select='id' orderBy='filename'></Item>"
        resultSoap = Me.SendSoap(AML)
        Dim listfiles As XmlNodeList = resultSoap.GetElementsByTagName("Item")
        Return listfiles


    End Function

    Public Function GetVaultNames()

        Dim resultSoap As Xml.XmlDocument
        Dim AML As String = "" & _
        "<Item type='Vault' action='get' Select='id,name' orderBy='filename'></Item>"
        resultSoap = Me.SendSoap(AML)
        Dim listfiles As XmlNodeList = resultSoap.GetElementsByTagName("Item")
        Return listfiles


    End Function

    Public Function CheckOutFile(ByVal fileID As String)

        Dim resultSoap As Xml.XmlDocument
        Dim AML As String = "" & _
        "<Item type='file' action='checkout' id='" & fileID & "' orderBy='filename'></Item>"
        resultSoap = Me.SendSoap(AML)
        Dim listfiles As XmlNodeList = resultSoap.GetElementsByTagName("Item")
        Return listfiles


    End Function

    Public Function SendSoap(ByVal MessageAML As String)

        Me.hashpass = Me.PW

        Dim SoapStart As String = "" & _
        "<SOAP-ENV:Envelope xmlns:SOAP-ENV='http://schemas.xmlsoap.org/soap/envelope/' " & _
        "encodingStyle='http://schemas.xmlsoap.org/soap/encoding/'><SOAP-ENV:Body>"

        Dim SoapEnd As String = "</SOAP-ENV:Body></SOAP-ENV:Envelope>"
        Dim SoapAction As String = "ApplyItem"
        Dim body As String = MessageAML
        Dim Soap As String = "" & _
        SoapStart & "<" & SoapAction & " xmlns:m='http://www.aras-corp.com/'> " & _
        body & "</" & SoapAction & ">" & SoapEnd

        Dim http As MSXML2.ServerXMLHTTP = New MSXML2.ServerXMLHTTP
        http.open("POST", Me.server & "server/innovatorserver.aspx", False)
        http.setRequestHeader("SOAPaction", SoapAction)
        http.setRequestHeader("AUTHUSER", Me.Login)
        http.setRequestHeader("AUTHPASSWORD", Me.PW)
        http.setRequestHeader("DATABASE", Me.database)
        http.send(Soap)

        Dim answer As String = http.responseText
        Dim XMLback As Xml.XmlDocument = New Xml.XmlDocument
        XMLback.LoadXml(answer)

        SoapAction = "logoff"
        http.open("POST", Me.server & "server/innovatorserver.aspx", False)
        http.setRequestHeader("SOAPaction", SoapAction)
        http.setRequestHeader("AUTHUSER", Me.Login)
        http.setRequestHeader("AUTHPASSWORD", Me.PW)
        http.setRequestHeader("DATABASE", Me.database)
        http.send(Soap)


        Return XMLback

    End Function

    Protected Overrides Sub Finalize()
        MyBase.Finalize()
    End Sub

    Private Function GetRandomArasID() As String

        Dim testidfound As Boolean
        testidfound = False
        Dim resultstring As String = ""

        ' this loop is just a random ID maker + a check to see if the file ID already exists
        ' so it loops while it doesn't find an available ID 
        While testidfound = False
            ' Generate a Random ID **************************************************
            Dim random As Random = New Random
            Dim randomstring As String = ""
            Dim i As Integer = 0
            i = 0
            While i < 4
                randomstring = Conversion.Hex(random.Next())
                resultstring = resultstring & randomstring.PadRight(8, "0")
                i = i + 1
            End While

            ' Check if the ID is available ******************************************
            Dim resultSoap As Xml.XmlDocument
            Dim AML As String = "" & _
            "<Item type='file' action='get' Select='id' orderBy='id' maxRecords='1'><id>" & resultstring & "</id></Item>"
            resultSoap = Me.SendSoap(AML)


            If resultSoap.GetElementsByTagName("id").Count > 0 Then
                testidfound = False
            Else
                testidfound = True
            End If

        End While
        Return resultstring

    End Function

End Class
